home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / pascal3 / pro16 / paste.pas < prev    next >
Pascal/Delphi Source File  |  1991-01-04  |  2KB  |  105 lines
  1. program Past_File;
  2.  
  3. USES Rline;
  4.  
  5. TYPE
  6.   RFtester = Object(RFextended)
  7.     PROCEDURE CheckRFerror; virtual;
  8.   END;
  9.  
  10.   PROCEDURE RFtester.CheckRFerror;
  11.     { Displays some of the common errors, and waits for a keypress. }
  12.   BEGIN
  13.     IF (RFerror = 0)or(RFerror = $FFFF) then exit;
  14.     WriteLn(RFerrorString);
  15.   END;
  16.  
  17. const beep:char=#7;
  18.       inpbufsize=10*1024;
  19.       outpbufsize=40*1024;
  20.  
  21. var s1,s2,inp,inp1,inp2,outp:string;
  22.     inpf1,inpf2:rftester;
  23.     outpf:text;
  24.     inpb1,inpb2:array [1..inpbufsize] of char;
  25.     outpb:array[1..outpbufsize] of char;
  26.  
  27. procedure read_parameter;
  28. var code:integer;
  29.  
  30.   function create_file:boolean;
  31.   var err:boolean;
  32.   begin
  33.     assign(outpf,outp);
  34.     (*$i-*)
  35.       rewrite(outpf);
  36.     (*$i+*)
  37.     err:=(ioresult<>0);
  38.     if err then writeln('Error opening ',outp,'!',beep) else
  39.       settextbuf(outpf,outpb);
  40.     create_file:=not(err);
  41.   end;
  42.  
  43.   function open_file:boolean;
  44.   var err:boolean;
  45.   begin
  46.     code:=pos('.',inp);
  47.     if code<>0 then begin
  48.       inp1:=copy(inp,1,code)+'LFT';
  49.       inp2:=copy(inp,1,code)+'RGT';
  50.     end else begin
  51.       inp1:=inp+'.LFT';
  52.       inp2:=inp+'.RGT';
  53.     end;
  54.     inpf1.Init(inp1, inpbufsize, inpb1); { try to open the file. }
  55.     inpf1.CheckRFerror;
  56.     err:=(inpf1.RFerror<>0);
  57.     if err then writeln('Error opening ',inp1,'!',beep) else begin
  58.       inpf2.Init(inp2, inpbufsize, inpb2); { try to open the file. }
  59.       inpf2.CheckRFerror;
  60.       err:=(inpf2.RFerror<>0);
  61.       if err then writeln('Error opening ',inp2,'!',beep)
  62.     end;
  63.     open_file:=not(Err);
  64.   end;
  65.  
  66. begin
  67.   inp:=paramstr(1);
  68.   while (not(open_file)) do begin
  69.     write('Input File Name (without extension) : ');
  70.     readln(inp);
  71.   end;
  72.   outp:=inp;
  73.   while(not(create_file)) do begin
  74.     write('Output File Name (with extension) : ');
  75.     readln(outp);
  76.   end;
  77. end;
  78.  
  79. procedure screen;
  80. begin
  81.   writeln('Paste File v 1.2 - (c) 1991 FD_SoftWare');
  82.   if paramcount<>1 then begin
  83.     writeln;
  84.     writeln('Usage:');
  85.     writeln('      PASTE [infile.ext]');
  86.     writeln;
  87.     writeln('Merge [file.LFT] and [file.RGT] in [file.ext]');
  88.     halt(1);
  89.   end;
  90.   writeln;
  91. end;
  92.  
  93. begin
  94.   screen;
  95.   read_parameter;
  96.   while ((inpf1.RFerror=0) and (inpf2.RFerror=0)) do begin
  97.     inpf1.freadln(s1);
  98.     inpf2.freadln(s2);
  99.     writeln(outpf,s1+s2);
  100.   end;
  101.   inpf1.done;
  102.   inpf2.done;
  103.   close(outpf);
  104. end.
  105.